home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_2
/
twview93.zip
/
EXAMINE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-18
|
4KB
|
139 lines
{ I keep forgetting to turn off 286 instruction set. So, better force it
off here, before I confuse any more 286 people. }
{$A+} { speed up us 80x86 guys }
{$B-} { I dig short circuits }
{$I+} { pisses people off when they hit a letter, but its better than
gigo. }
{$G-} { turn OFF 286 instruction set }
program InfoViewer;
{ written mid december 1990 to date by woody }
{ dos version }
uses
DOS, CRT, graph;
{$I headers.inc}
var {globals}
space : TheVoid;
BBSname : string;
g : text;
BaseChanged,
quit : boolean;
distances : distanceArray;
verbose : boolean; { text output verbose or terse codes }
mono : boolean; { for monochrome graphics in printouts }
svga : boolean; { special for autodetect. Not yet implemented.}
{$I QUEUE.INC }
{$I status.inc }
{$I misc.inc }
{$I distance.inc }
{$I viewdos.inc }
{$I textdisp.inc }
{$I portdisp.inc }
{$I notestuf.inc }
{$I basepath.inc }
{$I pathstuf.inc }
{$I sctrlist.inc }
{$I morepair.inc }
{$I teleport.inc }
{$I GSDATA.INC }
{$I busy.inc }
{$I netchang.inc }
{$I config.inc }
procedure menu;
const
left = 35;
right = 40;
begin
writeln('Choose one of ');
write('<A>dd note':left);
writeln('<B>usiest ports':right);
write('<C>lassify ports': left);
writeln('<D>elete note':right);
write('<E>vil pair [SxS & xxB]' : left );
writeln('Closest place to buy <F>ighters':right);
write('Note <I>nformation':left);
writeln('<L>ength & path between two sectors':right);
write('<M>isc config options':left);
writeln('<N>earest port':right);
write('<P>aired ports':left);
writeln('<Q>uit': right);
write('Nearest <S>ectors':left);
writeln('<T>ranswarp menu':right);
write('Nearest <U>nexplored sectors':left);
writeln('<V>iew space in graphic format':right);
write('<W>here is nearest fighter cloud':left);
writeln('Net change <X>' : right);
writeln('<Y>ou asked for non-adjacent trading pairs?':left);
writeln;
end; {menu}
function choice : char;
var
ch : string;
begin
write('(', BBSName, ') [A, B, C, D, E, F, I, L, M, N, P, Q, S, T, U, V, W, X, Y] Choice? ');
readln( ch );
if ch = '' then
choice := '?'
else
choice := upcase( ch[1] );
end;
begin
Textcolor( LightGray );
clrScr;
writeln('Tradewars Data Base Viewer: ', version);
writeln( author );
writeln( source );
writeln;
Quit := false;
BaseChanged := false;
SVGA := false;
verbose := true;
Mono := false;
InitSpace( Space );
if paramcount > 0 then
BBSName := paramstr( 1 )
else
BBSName := '';
GetData( Space, BBSName );
menu;
repeat
case choice of
'A' : AddNote( BaseChanged );
'B' : BusyPorts;
'C' : NearestStuff( SpecPort, GetPortType );
'D' : RemoveNote( BaseChanged );
'E' : PairSearch( 'SXS', 'XXB' ); {evil pair}
'F' : NearestFighters;
'I' : NearestStuff( NoteOnly, 0 );
'L' : PathLength;
'M' : ConfigStuff;
'N' : NearestStuff( PortOnly, 0 );
'P' : pairPort;
'Q' : quit := true;
'S' : NearestStuff( any, 0);
'T' : TransWarpMenu( BaseChanged );
'U' : NearestStuff( UnExpOnly, 0);
'V' : view;
'W' : NearestStuff( FighterOnly, 0 );
'X' : HighChange;
'Y' : PairSearch( 'XSB', 'XBS' );
else
menu;
end; {case}
until quit;
if BaseChanged then
begin
assign( g, GetNewFileName('File name for new data base? ',
bbsname+'.dat') );
rewrite( g );
saveData( g, space );
end;
end.